home *** CD-ROM | disk | FTP | other *** search
/ MacAddict 84 / MacAddict_084_2003_08.iso / pc / Software / Audio & Music / Audacity 1.1.3.dmg / nyquist / misc.lsp < prev    next >
Lisp/Scheme  |  2002-09-16  |  2KB  |  72 lines
  1. ;## misc.lsp -- a collection of useful support functions
  2.  
  3. ; enable or disable breaks
  4. (defun bkon () (setq *breakenable* T))
  5. (defun bkoff () (setq *breakenable* NIL))
  6.  
  7. (bkon)
  8.  
  9. ;; (grindef 'name) - pretty print a function
  10. ;;
  11. (defun grindef (e) (pprint (get-lambda-expression (symbol-function e))))
  12.  
  13. ;; (incf <place>), (decf <place>) - add/sub 1 to/from variable
  14. ;;
  15. (defmacro incf (symbol) `(setf ,symbol (1+ ,symbol)))
  16. (defmacro decf (symbol) `(setf ,symbol (1- ,symbol)))
  17.  
  18.  
  19. ;; (push val <place>) - cons val to list
  20. ;;
  21. (defmacro push (val lis) `(setf ,lis (cons ,val ,lis)))
  22. (defmacro pop (lis) `(setf ,lis (cdr ,lis)))
  23.  
  24. ;; include this to use RBD's XLISP profiling hooks
  25. ;;(load "/afs/andrew/usr/rbd/lib/xlisp/profile.lsp")
  26.  
  27. ;(cond ((boundp 'application-file-name)
  28. ;       (load application-file-name)))
  29.  
  30.  
  31. (defun get-input-file-name ()
  32.   (let (fname)
  33.     (format t "Input file name: ")
  34.     (setf fname (read-line))
  35.     (cond ((equal fname "") (get-input-file-name))
  36.           (t fname))))
  37.  
  38.  
  39. (defun open-output-file ()
  40.   (let (fname)
  41.     (format t "Output file name: ")
  42.     (setf fname (read-line))
  43.     (cond ((equal fname "") t)
  44.           (t (open fname :direction :output)))))
  45.  
  46.  
  47. (defmacro while (cond &rest stmts)
  48.   `(prog () loop (if ,cond () (return)) ,@stmts (go loop)))
  49.  
  50. (defmacro when (test action)
  51.         (list 'cond (list test action)))
  52.  
  53. ; when parens/quotes don't match, try this
  54. ; 
  55. (defun file-sexprs ()
  56.   (let ((fin (open (get-input-file-name)))
  57.         inp)
  58.     (while (setf inp (read fin)) (print inp))))
  59.  
  60. ;; get path for currently loading file (if any)
  61. ;;
  62. (defun current-path ()
  63.   (let (fullpath n)
  64.     (setf n -1)
  65.     (cond (*loadingfiles*
  66.            (setf fullpath (car *loadingfiles*))
  67.            (dotimes (i (length fullpath))
  68.              (cond ((equal (char fullpath i) *file-separator*)
  69.                     (setf n i))))
  70.            (subseq fullpath 0 (1+ n)))
  71.           (t nil))))
  72.